00100		SUBROUTINE SCAHEX
00200	
00300	C	NOVEMBER 9, 69
00400
00500		DIMENSION LIST5(0/1000),LIST(6,1000),
00600		1 XP(0/176),YP(0/176),T(0/1415),HYSTAB(0/15)
00700
00800		INTEGER  CIRCLE,RETA,CIRLOD,
00900		1 FILEN,FLINE,FLINEC,I,IC,IRR,
01000		1 IX,IY,JX,JY,LIST5,
01100		1 LLINE,LLINEC,LSIDE,LSIDEC,NX,NY,NEWEND,
01200		1 PARMAX,RSIDE,RSIDEC,STEPX,
01300		1 STEPY,TAPE,XP,YP,
01400		1 OLDEND,N,X,Y,BITS,ENDOLD,
01500		1 XFI,XLA,YFI,YLA
01600
01700		REAL DII,CL,SL,D,B,COH,DI,T,HALF,QI,RAT,
01800		1 LEAP,LIST,RR,RX,RY,CH,CHH
01900
02000		LOGICAL FORWAR,DEBUG,LO,MISSD,EMPTY
02100
02200		COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
02300		1 DEBUG,T,XP,YP,PARMAX,
02400		1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
02500	
02600		COMMON /LISTC/ LIST,LIST5,NEWEND,LO
02700	
02800		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
02900		1 LSIDE,RSIDE,DTA,HYSTAB
03000
03100		DO 10 N=0,1000
03200	10	LIST5(N)=N+1
03300	20	FORMAT(' TYPE DESIRED CIRCLE SIZE NUMBER'/)
03400	30	FORMAT(I)
03500	40	FORMAT(1H+,I1/)
03600		DEBUG=.FALSE.
03700		XFI=2
03800		XLA=1
03900		YFI=2
04000		YLA=1
04100		QI=1.0
04200		IF((LLINE.GT.256).OR.(RSIDE.GT.333)) QI=4.0
04300	50	FORMAT(' PRESCRIBE CONFIDENCE THRESHOLD'/)
04400	49	TYPE 50
04500	51	FORMAT(F)
04600		ACCEPT 51,CHH
04700	52	FORMAT(1H+,F4.2/)
04800	CC	TYPE 52,CHH
04900		IF((0.0.LT.CHH).AND.(CHH.LT.1.0)) GOTO 44
05000		TYPE 53
05100		GOTO 49
05200	42	FORMAT(' PRESCRIBE DIFFERENCE THRESHOLD'/)
05300	44	TYPE 42
05400		ACCEPT 51,DII
05500	CC	TYPE   52,DII
05600		IF((DII.GT.0.0).AND.(DII.LT.15.0)) GOTO 54
05700	53	FORMAT(' YOU MUST BE KIDDING')
05800		TYPE 53
05900		GOTO 44
06000	C	LOAD WITH DDT  DEBUG,XFI,XLA,YFI,YLA
06100	54	DII=DII*QI
06200		DI=DII/2.0
06300		CH=1.0-2.0*(1.0-CHH)
06400	47	FORMAT(1X)
06500		IF(DEBUG) PRINT 47
06600		TYPE 20
06700		ACCEPT 30,CIRCLE
06800	CC	TYPE 40,CIRCLE
06900		HALF=0.5
07000		GOTO(80,90,100,110,120), CIRCLE
07100	70	FORMAT(16H WRONG CIRCLE, = I)
07200		TYPE 70, CIRCLE
07300		CALL EXIT
07400	80	FILE=5HSIZE1
07500		HALF=0.
07600		GOTO 140
07700	90	FILE=5HSIZE2
07710		PARMAX=51
07800		HALF=0.
07900		GOTO 140
08000	100	FILE=5HSIZE3
08010		PARMAX=68
08100		GOTO 140
08200	110	FILE=5HSIZE4
08300		GOTO 140
08400	120	FILE=5HSIZE5
08500	140	IF((RETA.EQ.1234567897).AND.(CIRCLE.EQ.CIRLOD)) GOTO 205
08600	CC144	FORMAT(' TYPE NUMBER OF DEVICE PROVIDING THE TABLE'/)
08700	CC	TYPE 144
08800	CC	ACCEPT 30,TAPE
08900	CC148	FORMAT(1H+,I2)
09000	CC	TYPE 148,TAPE
09100	CC	TAPE=TAPE+8
09150	CC	CALL ZERPP
09162		TAPE=1
09175		REWIND TAPE
09200		CALL IFILE(TAPE,FILE)
09300		READ(TAPE)FILEN,(T(N),N=0,FILEN-356),XP,YP,PARMAX
09350	CC	READ(TAPE)FILEN,(T(N),N=0,FILEN-356),XP,N,YP,PARMAX
09375	C  ABOVE CHANGE TO TRY  TO READ TABLES PROPERLY
09400		CIRLOD=CIRCLE
09500		RETA=1234567897
09600	150	FORMAT(' TABLES HAVE BEEN LOADED NOW')
09700		TYPE 150
09800	205	IF((PARMAX-31)*(PARMAX-51)*(PARMAX-68)*(PARMAX-136)*
09900		1(PARMAX-176).EQ.0) GOTO 200
10000	180	FORMAT(14H FALSE PARMAX= I)
10100		TYPE 180, PARMAX
10200		CALL EXIT
10300	200	RR=SQRT((PARMAX+1)/3.1415927)
10400		CALL MSCAN
10500		LO=.FALSE.
10600		IF(DEBUG) PRINT 214,RETA,REIM,CIRCLE,CHH,FILE,
10700		1 FLINE,LLINE,LSIDE,RSIDE,BITS
10800	214	FORMAT(6H RETA=L1,4X5HREIM=L1,4X7HCIRCLE=I1,4X,4HCHH
10900		1=F4.1,4X5HFILO=A5,4X6HFLINE=I3,4X6HLLINE=I3,4X6H
11000		1LSIDE=I3,4X6HRSIDE=I3,4X5HBITS=I1//)
11100
11200	218	FORMAT(10H COMPUTING)
11300		TYPE 218
11400		IRR=IFIX(RR+0.5)
11500		LSIDEC=LSIDE+IRR
11600		RSIDEC=RSIDE-IRR
11700		FLINEC=FLINE+IRR
11800		LLINEC=LLINE-IRR
11900		LEAP=RR/2.+2.41
12000		IF(DEBUG) CALL ASD(8,'LEAP',LEAP)
12100		FORWAR=.TRUE.
12200		STEPY=IRR
12300		STEPX=(2*IFIX(0.5773*RR+.5))
12400		IX=(RSIDEC-LSIDEC-STEPX/2)/STEPX
12500		IY=(LLINEC-FLINEC)/STEPY
12600		NEWEND=0
12700		OLDEND=0
12800		NY=FLINEC-STEPY
12900	C	HERE BEGINS THE SCANNING
13000
13100		DO 234 JY=0,IY
13200		NY=NY+STEPY
13300		IC=MOD(JY,2)*STEPX/2
13400		OLDEND=NEWEND
13500		NX=LSIDEC-STEPX+IC
13600
13700		DO 241 JX=0,IX
13800		NX=NX+STEPX
13900		DEBUG=((XFI.LE.NX).AND.(NX.LE.XLA)).AND.((
14000		1YFI.LE.NY).AND.(NY.LE.YLA))
14100	CC	IF(.NOT.DEBUG) GOTO 322
14200	CC	CALL ASD(8,'NX',NX)
14300	CC	CALL ASD(8,'NY',NY)
14400	322	IF(SEINF(NX,NY)) GOTO 240
14500		CALL EDGE(NX,NY)
14600		RAT=(D/DI)**2
14700		IF((1-COH).GT.(1-CH)*RAT/(1.0+RAT)) GOTO 240
14800
14900	C	HERE BEGINS THE TRACING
15000		EMPTY=.TRUE.
15100	1300	FORMAT(8H ERROR L//)
15200		IF(LEAP.LT.0.) TYPE 1300
15300	1200	FORMAT(8H ERROR F//)
15400		IF(.NOT.FORWAR) TYPE 1200
15500		FORWAR=.TRUE.
15600		MISSD=.TRUE.
15700	370	X=IFIX(RX+HALF)
15800		Y=IFIX(RY+HALF)
15900		GOTO 270
16000	230	ENDOLD=NEWEND
16100		CALL PLUG(ENDOLD,RX,RY,CL,SL,D,B)
16200	229	MISSD=.TRUE.
16300		X=IFIX(RX+SL*LEAP+HALF)
16400		Y=IFIX(RY-CL*LEAP+HALF)
16500	270	IF(X.LT.LSIDEC) GOTO 232
16600		IF(X.GT.RSIDEC) GOTO 232
16700		IF(Y.LT.FLINEC) GOTO 232
16800		IF(Y.GT.LLINEC) GOTO 232
16900		IF(SEINF(X,Y)) GOTO 232
17000	CC	IF(.NOT.DEBUG) GOTO 235
17100	CC	CALL ASD(9,'    X',X)
17200	CC	CALL ASD(9,'    Y',Y)
17300	235	CALL EDGE(X,Y)
17400		RAT=(D/DII)**2
17500		IF((1-COH).LT.(1-CHH)*RAT/(1.0+RAT)) GOTO 233
17600		IF(EMPTY) GOTO 240
17700		MISSD=.NOT.MISSD
17800		IF(.NOT.MISSD) GOTO 370
17900	232	IF(EMPTY) GOTO 240
18000		LEAP=-LEAP
18100		FORWAR=.NOT.FORWAR
18200		IF(.NOT.FORWAR) GOTO 237
18300		OLDEND=NEWEND
18400		GOTO 240
18500	237	N=LIST5(OLDEND)
18600		RX=LIST(1,N)
18700		RY=LIST(2,N)
18800		CL=LIST(3,N)
18900		SL=LIST(4,N)
19000		GOTO 229
19100	233	IF(SEINT(IFIX(RX+.5),IFIX(RY+.5))) GOTO 232
19200		EMPTY=.FALSE.
19300	CC	IF(.NOT.DEBUG) GOTO 236
19400	CC	CALL ASD(1,'FORWAR',FORWAR)
19500	CC	CALL ASD(1,'RX',RX)
19600	CC	CALL ASD(1,'RY',RY)
19700	236	IF(FORWAR) GOTO 230
19800		CALL PLUG(OLDEND,RX,RY,CL,SL,D,B)
19900		GOTO 229
20000	240	IF(LO) GOTO 255
20100	241	CONTINUE
20200	234	CONTINUE
20300
20400	255	IF(NEWEND.GT.0) GOTO 250
20500		TYPE 260
20600	260	FORMAT(9H NO LISTS)
20700		CALL EXIT
20800	250	CALL STRAIT
20900		RETURN
21000		END